;; representation of a white stone, also being used to represent the white player
(defvar *white* 'W)

;; representation of a black stone, also used for the black player
(defvar *black* 'B)

;; sizeofboard
(defvar *boardsize* 19)

(defvar *num_moves* 1)

;;;
;;;
;;; Utilities
;;;
;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Test
;;;



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Program Code
;;;


;;; defines a board.  A board is made up of 3 lists:
;;; a list of the empty points on the board, the black
;;; points on the board, and the white points.  Each 
;;; element of the list should be a complex number of
;;; the form x + yi.
;;;
;;; When initially instantiated, in empty state.
;;;
;;; Uses chinese counting - doesn't keep track of captured stones
(defclass board (STANDARD-OBJECT)
  ((empty :initarg :empty :accessor empty :initform (gen-original-empty-list))
   (goban :initarg :goban :accessor goban :initform 
	                                  (make-array `(,boardsize ,boardsize) 
						      :initial-element nil))
   ;; used in determining ko - last moves
   ;; initialized with an invalid move
   (last-black :initarg :last-black :accessor last-black :initform #C(-1 -1))
   (last-white :initarg :last-white :accessor last-white :initform #C(-1 -1))
   (num-last-capture :initarg :capture :accessor num-last-capture :initform 0)))


;; makes copy of board for nondestrutive manipulation
(defmethod copy ((b board))
  (make-instance 'board :empty (empty b)
		       	:goban (goban b)
			:last-black (last-black b)
			:last-white (last-white b)
			:capture (num-last-capture b)))


(defun gen-original-empty-list ()
  (let ((lst '()))
    (dotimes (x *boardsize*)
      (dotimes (y *boardsize*)
	(push (complex (+ x 1) (+ y 1)) lst)))
    lst))

;;;; functions to play a move for a player

;; half-assed - won't work if point is returned from a setf, for example
;; If I need to do something like that, fix.
(defmacro get-point (board point)
  `(aref ,(board) (realpart ,point) (imagpart ,point)))


(defmethod add-stone ((b board) point player)
  (setf (get-point (goban b) point) player)
  (setf (empty b) (remove point (empty b))))

;; 'captures' a stone
(defmethod remove-stone ((b board) point)
  (setf (get-point (goban b) point) nil)
  (setf (empty b) (cons point (empty b))))

;; 'captures' a group of stones
(defmethod remove-stones ((b board) stones)
  (dolist (point stones)
    (add-stone b point)))


;; returns the other player
(defmethod other-player (player)
  (if (equal player *black*)
    *white*
    *black*))

;; get the player who played a peice
(defmethod get-player ((b board) point)
  (get-point (goban b) point))
  
;; takes a list of points, and returns a list of those points
;; one which a player has stones
(defmethod players-stones ((b board) points player)
  (cond 
    ((null points) '())
    ((equal player (get-player b (car points))) (cons (car points)
						     (players-stones 
						       b (cdr points) player)))
    (t (players-stones b (cdr points) player))))


;;;; plays a move for either black or white
;;;; assumes that the point is free and the move is valid 
;;;; 			(e.g. no ko, not suicide)
;;;; check move's validity before calling this method

(defmethod play-move ((b board) point player)
  (add-stone b point player)
  ;; dead neighbors are all of the white stones next to the played stone which
  ;; are dead.  Captures is the chains of stones that are captured.
  (let* ((enemy-neighbors (players-stones (goban b)
					  (get-neighbors point) 
					  (other-player player)))
	 (captures (set-reduce (mapcan (lambda (p) (gen-dead-group b p)) 
					      enemy-neighbors))))
    (remove-stones b captures (other-player player))))

;; todo - come up with better name
;;
;; attempt to play a move.  Return nil if illegal
(defmethod play ((b board) point player)
  (if (valid-movep b point player)
    (play-move b point player)
    nil))
;; does some extra testing to see if a move is retarded
(defmethod comp-play ((b board) point player)
  (if (eyep b point player)
    nil
    (play b point player)))

;;;;;
;;;;; ABSOLUTELY TERRIBLE RUNTIME!!!!!!!!!!!!!!!!!!!!!!!!
;;;;; rewrite


;; generates a list of points that are in a group
(defmethod gen-group ((b board) point)
    (let ((points (players-stones b (get-player b point))))
      (gen-group-helper (remove point points)
			'()
			`(,point))))

;; played-points is all of the players played stones, which are not in the other
;; variables
;; points-acc is the previously considered points which are in the group

(defmethod gen-group-helper (played-points points-acc curr-points)
  (let* ((neighbors (intersection (set-reduce (mapcan #'get-neighbors 
						     curr-points))
				  played-points))
	(next-played-points (set-difference played-points neighbors))
	(next-points-acc (append points-acc curr-points)))
    (if neighbors
      (gen-group-helper next-played-points next-points-acc neighbors)
      next-points-acc)))


;; if current group is dead, returns it.  Else, returns nil
(defmethod gen-dead-group ((b board) point) 
	(if (capturedp b point)
			(gen-group b point)
			nil))

;;;
;;; PREDICATES
;;;

;;; is this move valid?
;;; i.e. not ko, not in suicide
(defmethod valid-movep ((b board) point player)
  (and (find point (empty b)) 
       (not (kop b point player))
       (not (suicidep b point player))))




;; is a given move suicide?
(defmethod suicidep ((b board) point player)
  (let ((temp-board (copy b))
	(enemy-neighbors (intersection (get-neighbors point) 
				       (other-players-stones b player))))
    ;; play point non-destructively -- in a temporary board
    (add-stone temp-board point player)
    ;; see if in suicide
    (cond 
      ;; captured something, not in suicide
      ((mapcan (lambda (point-prime) 
		 (capturedp temp-board point-prime))
	       enemy-neighbors)
       nil)
	  ;; Didn't capture anything; Have no liberties
	((capturedp temp-board point) t)
	  ;; Have liberties, not suicide
	(t nil))))




;; is a group of stones captured?  t if they have no liberties

(defmethod capturedp ((b board) point)
  (let ((group (gen-group b point)))
    (not (mapcan (lambda (p) (intersection (empty b) 
					   (get-neighbors p)))
		 group))))

;; is there currently a ko?
;; player should be the variable *black* or *white*
(defmethod kop ((b board) point player)
  (if (eql player *black*)
    (kop-helper b point (last-black b))
    (kop-helper b point (last-white b))))

;; helper function for kop
(defmethod kop-helper ((b board) point last-point)
  (and (= 1 (num-last-capture b))
       (= last-point point)))





;; is this a living group?  If so, don't bother playing in it
;; todo - write up a detailed life-checker
(defmethod livingp ())

;; stupid definition of an eye.  Guarenteed to be an eye, but not all eyes will
;; register.  takes a liberty and a player whose eye it can be
(defmethod eyep ((b board) point player)
  (let* ((neighbors (get-neighbors point))
	(diagonals (get-diagonals point))
	(color-neighbors (intersection neighbors 
				       (players-stones b player)))
	(color-diagonals (intersection diagonals
				       (players-stones b player))))
    ;; a point is an eye if all of it's neighbors are the players stones, and at least 3 diagonals
    ;; are also occupied by the player
    (if (and (= 4 (length color-neighbors)) (>= (length color-diagonals)
					       3))
      t
      nil)))



(defmethod random-move ((b board) player)
  (random-move-helper b (empty b) player))

;; try all possible moves in a random order, until one works
;; #C(-1 -1) means a pass
(defmethod random-move-helper ((b board) moves player)
  (if moves
    ;; possible moves are left, try one
    (let* ((move (nth (random (length moves)) moves))
	  (result (comp-play b move player)))
      (if result
	;; move succeded
	move
	;; move failed - try the rest
	 (random-move-helper b (remove move moves) player)))
    #C(-1 -1)))

(defmethod random-playout ((b board) player)
  (setf *num_moves* (+ 2 *num_moves*))
  ;; move1 or move2 are nil if it's a pass
  (let ((move1 (random-move b player))
	(move2 (random-move b (other-player player))))
    ;; game over if both pass, otherwise, execute again
    (if (and (= move1 #C(-1 -1)) 
		 (= move2 #C(-1 -1)))
      b
      (random-playout b player))))

(defmethod random-partial-playout ((b board) player n)
  (random-move b player)
  (random-move b (other-player player))
  (if (= n 0)
    (display-board b)
    (random-partial-playout b player (1- n))))


;; returns how much a player won by
(defmethod score ((b board) player)
  (let* ((players-eyes (get-players-eyes b player))
	 (other-players-eyes (get-players-eyes b (other-player player)))
	 (players-points (+ (players-stones b player) players-eyes))
	 (other-players-points (+ (other-players-stones b player)
				  other-players-eyes))
	 (score (- players-points other-players-points)))
    score))

(defmethod get-players-eyes ((b board) player)
  ())



;;;
;;; Display
;;;



;; takes a board object and creates a displayable board with the position on it
;; The displayable board is an n-by-n tree with B, W or NIL representing the board
(defmethod display-board ((b board))
  (gen-position (gen-display-board) (black b) (white b)))


;; generate a position of a list of black stones and white
(defun gen-position (board black white)
    (cond
	(black (set-point (gen-position board (cdr black) white) 
			  (car black) *black*))
	(white (set-point (gen-position board  black (cdr white)) 
			  (car white) *white*))
	(t	board)))

;; make board of size x-by-x - defined by boardsize
(defun gen-display-board () 
    (make-list *boardsize* :initial-element
	    (make-list *boardsize* :initial-element '_)))

;; find the value of the (x,y) point on board
(defun get-point-color (board point)
    (nth (- (imagpart point) 1)
	(nth (- (realpart point) 1) board)))

;; copy a row of the board
(defun copy-row (row)
    (if row 
	(cons (car row) 
	      (copy-row (cdr row)))
	nil))

;; copy a row of the board, changing one value
(defun change-row (row y value)
    (if row
	(if (= y 1)
	    (cons value 
		(change-row (cdr row) (- y 1) value))
	    (cons (car row) 
		(change-row (cdr row) (- y 1) value)))
	nil))

;; recursively copy board, changing one value 
(defun set-point (board point value)  
    (if board
	(if (= (realpart point) 1)
	     (cons (change-row (car board) (imagpart point) value) 
		(set-point (cdr board) (- point 1) value))
	    (cons (copy-row (car board)) 
		(set-point (cdr board) (- point 1) value)))
	nil))


;; return any valid ajacent points to a stone in a list of #C(x y) points
(defun get-neighbors (point)
    (let ( (neighbors '())
	   (x (realpart point))
	   (y (imagpart point)))
	(if (> x 1) 
	    (setf neighbors (cons (complex (- x 1) y) neighbors)))
	(if (> y 1)
	    (setf neighbors (cons (complex x (- y 1)) neighbors)))
	(if (< x *boardsize*)
	    (setf neighbors (cons (complex (+ x 1) y) neighbors)))
	(if (< y *boardsize*)
	    (setf neighbors (cons (complex x (+ y 1)) neighbors)))
	;; return neighbors
	neighbors))

;; returns any valid diagonal points from a point
(defun get-diagonals (point)
    (let ( (neighbors '())
	   (x (realpart point))
	   (y (imagpart point)))
	(if (and (> x 1) (> y 1)) 
	    (setf neighbors (cons (complex (1- x ) (1- y)) neighbors)))
	(if (and (< x *boardsize*) (> y 1))
	    (setf neighbors (cons (complex (1+ x) (1- y)) neighbors)))
	(if (and (< x *boardsize*) (> y *boardsize*))
	    (setf neighbors (cons (complex (1+ x) (1+ y)) neighbors)))
	(if (and (> x 1) (< y *boardsize*))
	    (setf neighbors (cons (complex (1- x) (1+ y )) neighbors)))
	;; return neighbors
	neighbors))


(setf brd (make-instance 'board))
